home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / unix / tclLoadShl.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  3.7 KB  |  130 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclLoadShl.c --
  3.  *
  4.  *    This procedure provides a version of the TclLoadFile that works
  5.  *    with the "shl_load" and "shl_findsym" library procedures for
  6.  *    dynamic loading (e.g. for HP machines).
  7.  *
  8.  * Copyright (c) 1995-1996 Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * SCCS: @(#) tclLoadShl.c 1.5 96/03/15 15:01:44
  14.  */
  15.  
  16. #include <dl.h>
  17.  
  18. /*
  19.  * On some HP machines, dl.h defines EXTERN; remove that definition.
  20.  */
  21.  
  22. #ifdef EXTERN
  23. #   undef EXTERN
  24. #endif
  25.  
  26. #include "tcl.h"
  27.  
  28. /*
  29.  *----------------------------------------------------------------------
  30.  *
  31.  * TclLoadFile --
  32.  *
  33.  *    Dynamically loads a binary code file into memory and returns
  34.  *    the addresses of two procedures within that file, if they
  35.  *    are defined.
  36.  *
  37.  * Results:
  38.  *    A standard Tcl completion code.  If an error occurs, an error
  39.  *    message is left in interp->result.  *proc1Ptr and *proc2Ptr
  40.  *    are filled in with the addresses of the symbols given by
  41.  *    *sym1 and *sym2, or NULL if those symbols can't be found.
  42.  *
  43.  * Side effects:
  44.  *    New code suddenly appears in memory.
  45.  *
  46.  *----------------------------------------------------------------------
  47.  */
  48.  
  49. int
  50. TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
  51.     Tcl_Interp *interp;        /* Used for error reporting. */
  52.     char *fileName;        /* Name of the file containing the desired
  53.                  * code. */
  54.     char *sym1, *sym2;        /* Names of two procedures to look up in
  55.                  * the file's symbol table. */
  56.     Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
  57.                 /* Where to return the addresses corresponding
  58.                  * to sym1 and sym2. */
  59. {
  60.     shl_t handle;
  61.     Tcl_DString newName;
  62.  
  63.     handle = shl_load(fileName, BIND_IMMEDIATE, 0L);
  64.     if (handle == NULL) {
  65.     Tcl_AppendResult(interp, "couldn't load file \"", fileName,
  66.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  67.     return TCL_ERROR;
  68.     }
  69.  
  70.     /*
  71.      * Some versions of the HP system software still use "_" at the
  72.      * beginning of exported symbols while others don't;  try both
  73.      * forms of each name.
  74.      */
  75.  
  76.     if (shl_findsym(&handle, sym1, (short) TYPE_PROCEDURE, (void *) proc1Ptr)
  77.         != 0) {
  78.     Tcl_DStringInit(&newName);
  79.     Tcl_DStringAppend(&newName, "_", 1);
  80.     Tcl_DStringAppend(&newName, sym1, -1);
  81.     if (shl_findsym(&handle, Tcl_DStringValue(&newName),
  82.         (short) TYPE_PROCEDURE, (void *) proc1Ptr) != 0) {
  83.         *proc1Ptr = NULL;
  84.     }
  85.     Tcl_DStringFree(&newName);
  86.     }
  87.     if (shl_findsym(&handle, sym2, (short) TYPE_PROCEDURE, (void *) proc2Ptr)
  88.         != 0) {
  89.     Tcl_DStringInit(&newName);
  90.     Tcl_DStringAppend(&newName, "_", 1);
  91.     Tcl_DStringAppend(&newName, sym2, -1);
  92.     if (shl_findsym(&handle, Tcl_DStringValue(&newName),
  93.         (short) TYPE_PROCEDURE, (void *) proc2Ptr) != 0) {
  94.         *proc2Ptr = NULL;
  95.     }
  96.     Tcl_DStringFree(&newName);
  97.     }
  98.     return TCL_OK;
  99. }
  100.  
  101. /*
  102.  *----------------------------------------------------------------------
  103.  *
  104.  * TclGuessPackageName --
  105.  *
  106.  *    If the "load" command is invoked without providing a package
  107.  *    name, this procedure is invoked to try to figure it out.
  108.  *
  109.  * Results:
  110.  *    Always returns 0 to indicate that we couldn't figure out a
  111.  *    package name;  generic code will then try to guess the package
  112.  *    from the file name.  A return value of 1 would have meant that
  113.  *    we figured out the package name and put it in bufPtr.
  114.  *
  115.  * Side effects:
  116.  *    None.
  117.  *
  118.  *----------------------------------------------------------------------
  119.  */
  120.  
  121. int
  122. TclGuessPackageName(fileName, bufPtr)
  123.     char *fileName;        /* Name of file containing package (already
  124.                  * translated to local form if needed). */
  125.     Tcl_DString *bufPtr;    /* Initialized empty dstring.  Append
  126.                  * package name to this if possible. */
  127. {
  128.     return 0;
  129. }
  130.